home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / awordp1a / form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-10-13  |  10.7 KB  |  339 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
  4. Begin VB.Form Form1 
  5.    Caption         =   "RichTextBox Sample - [Noname]"
  6.    ClientHeight    =   6255
  7.    ClientLeft      =   3360
  8.    ClientTop       =   2295
  9.    ClientWidth     =   9150
  10.    Icon            =   "Form1.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   6255
  13.    ScaleWidth      =   9150
  14.    Begin RichTextLib.RichTextBox RTF2 
  15.       Height          =   1095
  16.       Left            =   9480
  17.       TabIndex        =   1
  18.       Top             =   2040
  19.       Width           =   495
  20.       _ExtentX        =   873
  21.       _ExtentY        =   1931
  22.       _Version        =   327680
  23.       TextRTF         =   $"Form1.frx":0442
  24.    End
  25.    Begin MSComDlg.CommonDialog CommonDialog1 
  26.       Left            =   1320
  27.       Top             =   6240
  28.       _ExtentX        =   847
  29.       _ExtentY        =   847
  30.       _Version        =   327680
  31.       CancelError     =   -1  'True
  32.       Filter          =   "RTF Files|*.RTF|Text Files|*.TXT|All Files|*.*"
  33.    End
  34.    Begin RichTextLib.RichTextBox RTF 
  35.       Height          =   6255
  36.       Left            =   0
  37.       TabIndex        =   0
  38.       Top             =   0
  39.       Width           =   9135
  40.       _ExtentX        =   16113
  41.       _ExtentY        =   11033
  42.       _Version        =   327680
  43.       ScrollBars      =   3
  44.       TextRTF         =   $"Form1.frx":0513
  45.    End
  46.    Begin VB.Menu MenuFile 
  47.       Caption         =   "&File"
  48.       Begin VB.Menu SubMenuNew 
  49.          Caption         =   "&New"
  50.          Shortcut        =   ^N
  51.       End
  52.       Begin VB.Menu SubMenuOpen 
  53.          Caption         =   "&Open..."
  54.          Shortcut        =   ^O
  55.       End
  56.       Begin VB.Menu SubMenuSave 
  57.          Caption         =   "&Save"
  58.          Enabled         =   0   'False
  59.          Shortcut        =   {F2}
  60.       End
  61.       Begin VB.Menu SubMenuSaveAs 
  62.          Caption         =   "&Save As..."
  63.       End
  64.       Begin VB.Menu SubMenuSaveaCopy 
  65.          Caption         =   "&Save a Copy..."
  66.       End
  67.       Begin VB.Menu Separator1 
  68.          Caption         =   "-"
  69.       End
  70.       Begin VB.Menu SubMenuExit 
  71.          Caption         =   "E&xit"
  72.          Shortcut        =   ^Q
  73.       End
  74.    End
  75.    Begin VB.Menu EditMenu 
  76.       Caption         =   "&Edit"
  77.       Begin VB.Menu OpenFindBox 
  78.          Caption         =   "Find..."
  79.          Shortcut        =   {F3}
  80.       End
  81.       Begin VB.Menu Separator3 
  82.          Caption         =   "-"
  83.       End
  84.       Begin VB.Menu EditSW 
  85.          Caption         =   "Select the Word"
  86.          Shortcut        =   ^W
  87.       End
  88.       Begin VB.Menu EditSS 
  89.          Caption         =   "Select the Sentence"
  90.          Shortcut        =   ^S
  91.       End
  92.    End
  93.    Begin VB.Menu MenuFont 
  94.       Caption         =   "F&ont"
  95.       Begin VB.Menu SubMenuRegular 
  96.          Caption         =   "Regular"
  97.       End
  98.       Begin VB.Menu CheckBold 
  99.          Caption         =   "Bold"
  100.          Shortcut        =   ^B
  101.       End
  102.       Begin VB.Menu CheckItalic 
  103.          Caption         =   "Italic"
  104.          Shortcut        =   ^I
  105.       End
  106.       Begin VB.Menu CheckUnderLine 
  107.          Caption         =   "UnderLine"
  108.          Shortcut        =   ^U
  109.       End
  110.       Begin VB.Menu CheckStrikeLine 
  111.          Caption         =   "StrikeLine"
  112.       End
  113.       Begin VB.Menu Separator2 
  114.          Caption         =   "-"
  115.       End
  116.       Begin VB.Menu SubMenuDialog 
  117.          Caption         =   "Dialog Box..."
  118.          Shortcut        =   ^F
  119.       End
  120.    End
  121.    Begin VB.Menu MenuHelp 
  122.       Caption         =   "Help"
  123.       Begin VB.Menu ShowAbout 
  124.          Caption         =   "About..."
  125.          Shortcut        =   {F1}
  126.       End
  127.       Begin VB.Menu ShowShortcut 
  128.          Caption         =   "Show the list of the Shortcut Keys"
  129.       End
  130.    End
  131. Attribute VB_Name = "Form1"
  132. Attribute VB_GlobalNameSpace = False
  133. Attribute VB_Creatable = False
  134. Attribute VB_PredeclaredId = True
  135. Attribute VB_Exposed = False
  136. Dim Saved As Boolean
  137. Dim Changed As Boolean
  138. Dim FileName As String
  139. Private Sub CheckBold_Click()
  140. CheckBold.Checked = Not CheckBold.Checked
  141. RTF.SelBold = CheckBold.Checked 'Set RTF.SelBold
  142. End Sub
  143. Private Sub CheckItalic_Click()
  144. CheckItalic.Checked = Not CheckItalic.Checked
  145. RTF.SelItalic = CheckItalic.Checked 'Set RTF.SelItalic
  146. End Sub
  147. Private Sub CheckStrikeLine_Click()
  148. CheckStrikeLine.Checked = Not CheckStrikeLine.Checked
  149. RTF.SelStrikeThru = CheckStrikeLine.Checked  'Set RTF.SelStrikeThru
  150. End Sub
  151. Private Sub CheckUnderLine_Click()
  152. CheckUnderLine.Checked = Not CheckUnderLine.Checked
  153. RTF.SelUnderline = CheckItalic.Checked 'Set RTF.SelUnderline
  154. End Sub
  155. Private Sub EditSS_Click()
  156. SelectSentence
  157. End Sub
  158. Private Sub EditSW_Click()
  159. SelectWord
  160. End Sub
  161. Private Sub Form_Load()
  162. FileName = "Noname"
  163. End Sub
  164. Private Sub Form_Resize()
  165. 'Resize the richtextbox as the form is resized
  166. On Error Resume Next
  167. RTF.Width = Form1.Width - 120
  168. RTF.Height = Form1.Height - 690
  169. End Sub
  170. Private Sub OpenFindBox_Click()
  171. Form2.Show
  172. End Sub
  173. Private Sub RTF_Change()
  174. Changed = True
  175. ChangeCaption
  176. End Sub
  177. Private Sub RTF_KeyUp(KeyCode As Integer, Shift As Integer)
  178. 'If user pushes Ctrl-S, the sentence which the cursor is on will be selected.
  179. 'If user pushes Ctrl-W, the word which the cursor is on will be selected.
  180. 'If user pushes Ctrl-Shift-S, the cursor will move to the end of the sentence.
  181. 'If user pushes Ctrl-Shift-W, the cursor will move to the end of the word.
  182. If Shift = vbCtrlMask Then
  183.     Select Case KeyCode
  184.         Case vbKeyS
  185.             SelectSentence
  186.         Case vbKeyW
  187.             SelectWord
  188.     End Select
  189. End If
  190. If Shift = (vbCtrlMask Or vbShiftMask) Then
  191.     Select Case KeyCode
  192.         Case vbKeyS
  193.             RTF.UpTo ".?!", True, False
  194.         Case vbKeyW
  195.             RTF.UpTo ",;:.?! ", True, False
  196.     End Select
  197. End If
  198. End Sub
  199. Private Sub SelectSentence()
  200. RTF.Span ".?!", False, True
  201. SelectionStart = RTF.SelStart
  202. RTF.Span ".?!", True, True
  203. SelectionEnd = RTF.SelStart + RTF.SelLength
  204. RTF.SelStart = SelectionStart
  205. RTF.SelLength = SelectionEnd - SelectionStart
  206. End Sub
  207. Private Sub SelectWord()
  208. RTF.Span " ,;:.?!", False, True
  209. SelectionStart = RTF.SelStart
  210. RTF.Span " ,;:.?!", True, True
  211. SelectionEnd = RTF.SelStart + RTF.SelLength
  212. RTF.SelStart = SelectionStart
  213. RTF.SelLength = SelectionEnd - SelectionStart
  214. End Sub
  215. Private Sub RTF_SelChange()
  216. CheckBold.Checked = IIf(RTF.SelBold = False, False, True)
  217. CheckItalic.Checked = IIf(RTF.SelItalic = False, False, True)
  218. CheckUnderLine.Checked = IIf(RTF.SelUnderline = False, False, True)
  219. CheckStrikeLine.Checked = IIf(RTF.SelStrikeThru = False, False, True)
  220. End Sub
  221. Private Sub ShowAbout_Click()
  222. Form1.Enabled = False
  223. Form3.Show
  224. End Sub
  225. Private Sub ShowShortcut_Click()
  226. Form1.Enabled = False
  227. Form4.Show
  228. End Sub
  229. Private Sub SubMenuDialog_Click()
  230. On Error Resume Next
  231. CommonDialog1.Flags = cdlCFBoth
  232. CommonDialog1.ShowFont
  233. RTF.SelFontName = CommonDialog1.FontName
  234. RTF.SelFontSize = CommonDialog1.FontSize
  235. RTF.SelStrikeThru = CommonDialog1.FontStrikethru
  236. RTF.SelUnderline = CommonDialog1.FontUnderline
  237. RTF.SelBold = CommonDialog1.FontBold
  238. RTF.SelItalic = CommonDialog1.FontItalic
  239. End Sub
  240. Private Sub SubMenuNew_Click()
  241. 'Make a new file!
  242. If Changed = True Then
  243. a = MsgBox("Do you want to save [" + FileName + "]?", vbYesNoCancel, "Alert!")
  244. If a = 2 Then Exit Sub
  245. If a = 7 Then GoTo 10
  246. If Saved = True Then SubMenuSave_Click Else SubMenuSaveAs_Click
  247. GoTo 10
  248. 10 RTF.Text = "": Changed = False
  249. ChangeCaption
  250. FileName = "Noname": SubMenuSave.Enabled = False
  251. Saved = False: SubMenuSave.Enabled = False
  252. End If
  253. End Sub
  254. Private Sub SubMenuOpen_Click()
  255. 'Open a saved file!
  256. On Error GoTo 10
  257. If Changed = True Then
  258.     a = MsgBox("Do you want to save [" + FileName + "]?", vbYesNoCancel, "Alert!")
  259.     If a = 2 Then Exit Sub
  260.     If a = 7 Then GoTo 20
  261.     If Saved = True Then SubMenuSave_Click Else SubMenuSaveAs_Click
  262. End If
  263. CommonDialog1.Flags = cdlOFNFileMustExist
  264. CommonDialog1.DefaultExt = "RTF"
  265. CommonDialog1.ShowOpen
  266.     If UCase(Right$(CommonDialog1.FileName, 3)) = "RTF" Then
  267.         tmode = rtfRTF
  268.     Else
  269.         tmode = rtfText
  270.     End If
  271.         
  272.     RTF.LoadFile CommonDialog1.FileName, tmode
  273.     FileName = CommonDialog1.FileName
  274.     Changed = False
  275.     ChangeCaption
  276.     SubMenuSave.Enabled = True
  277.     Saved = True
  278.     Exit Sub
  279. 10 MsgBox "Error while opening the file!"
  280. End Sub
  281. Private Sub SubMenuRegular_Click()
  282. 'Make the text regular font
  283. RTF.SelBold = False: CheckBold.Checked = False
  284. RTF.SelItalic = False: CheckItalic.Checked = False
  285. RTF.SelUnderline = False: CheckUnderLine.Checked = False
  286. RTF.SelStrikeThru = False: CheckStrikeLine.Checked = False
  287. End Sub
  288. Private Sub SubMenuSave_Click()
  289. Changed = False
  290. a = MsgBox("Do you want to save in RTF type? If you do, choose Yes. If you don't, choose No", vbYesNoCancel, "Choose the type")
  291.     If a = 2 Then Exit Sub
  292.     If K = 0 Then If a = 6 Then B = ".rtf" Else B = ".txt" Else B = ""
  293.     RTF.SaveFile CommonDialog1.FileName + B, a - 6
  294. End Sub
  295. Private Sub SubMenuSaveaCopy_Click()
  296. On Error GoTo 10
  297.     B = CommonDialog1.Filter
  298.     CommonDialog1.Filter = ""
  299.     CommonDialog1.ShowSave
  300.     CommonDialog1.Filter = B
  301.     For I = 1 To Len(CommonDialog1.FileTitle) - 1
  302.     B = Mid$(CommonDialog1.FileTitle, I, 1)
  303.     If B = "." Then K = I
  304.     Next I
  305.     a = MsgBox("Do you want to save in RTF type? If you do, choose Yes. If you don't, choose No", vbYesNoCancel, "Choose the type")
  306.     If a = 2 Then Exit Sub
  307.     If K = 1 Then B = "": GoTo 20
  308.     If a = 6 Then B = ".rtf" Else B = ".txt"
  309. 20  RTF.SaveFile CommonDialog1.FileName + B, a - 6
  310.     Exit Sub
  311. 10  MsgBox "Error while saving file", vbOKOnly, "Error"
  312. End Sub
  313. Private Sub SubMenuSaveAs_Click()
  314. 'Save As...
  315. On Error GoTo 10
  316.     B = CommonDialog1.Filter
  317.     CommonDialog1.Filter = ""
  318.     CommonDialog1.ShowSave
  319.     CommonDialog1.Filter = B
  320.     K = 0
  321.     For I = 1 To Len(CommonDialog1.FileTitle) - 1
  322.     B = Mid$(CommonDialog1.FileTitle, I, 1)
  323.     If B = "." Then K = I
  324.     Next I
  325.     a = MsgBox("Do you want to save in RTF type? If you do, choose Yes. If you don't, choose No", vbYesNoCancel, "Choose the type")
  326.     If a = 2 Then Exit Sub
  327.     If K > 0 Then B = "": GoTo 20
  328.     If a = 6 Then B = ".rtf" Else B = ".txt"
  329. 20  RTF.SaveFile CommonDialog1.FileName + B, a - 6
  330.     Changed = False: FileName = CommonDialog1.FileName + B: ChangeCaption
  331.     Saved = True: SubMenuSave.Enabled = True
  332.     Exit Sub
  333. 10  MsgBox "Error while saving file", vbOKOnly, "Error"
  334. End Sub
  335. Sub ChangeCaption()
  336. If Changed = True Then m = "*" Else m = ""
  337. Form1.Caption = "RichTextBox Sample [" + FileName + "] " + m
  338. End Sub
  339.